home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
ada
/
gwuada_9.zip
/
LIBW.C
< prev
next >
Wrap
C/C++ Source or Header
|
1993-07-27
|
43KB
|
1,504 lines
/*
* Copyright (C) 1985-1992 New York University
*
* This file is part of the Ada/Ed-C system. See the Ada/Ed README file for
* warranty (none) and distribution info and also the GNU General Public
* License for more details.
*/
/* libw - procedures for writing (in C format) ais and tre files*/
#ifdef __GNUG__
extern "C"
{
#include <sys/types.h>
#include <sys/dir.h>
}
#endif
#include "hdr.h"
#include "vars.h"
#include "libhdr.h"
#include "ifile.h"
#include "setp.h"
#include "dbxp.h"
#include "miscp.h"
#include "smiscp.h"
#include "chapp.h"
#include "libp.h"
#include "libfp.h"
#include "libwp.h"
#ifdef BSD
/* Needed for cleanup_files routine */
#include <sys/types.h>
#include <sys/dir.h>
#endif
#ifdef SYSTEM_V
/* Needed for cleanup_files routine */
#include <fcntl.h>
#include <sys/types.h>
#include <sys/dir.h>
#endif
#ifdef IBM_PC
#include <dos.h>
#include <errno.h>
#endif
extern char *LIBRARY_PREFIX;
extern IFILE *TREFILE, *AISFILE, *STUBFILE, *LIBFILE;
static void putdcl(IFILE *, Declaredmap);
static void putlitmap(IFILE *, Symbol);
static void putnod(IFILE *, char *, Node);
static void putnodref(IFILE *, char *, Node);
static void putint(IFILE *, char *, int );
static void putlong(IFILE *, char *, long);
static void putmisc(IFILE *, Symbol);
static void putrepr(IFILE *, Symbol);
static void putunt(IFILE *, char *, unsigned int);
static void putnval(IFILE *, Node);
static void putuint(IFILE *, char *, int *);
static void putovl(IFILE *, Symbol);
static void putsig(IFILE *, Symbol);
static void putsym(IFILE *, char *, Symbol);
static void putudecl(IFILE *, int);
static long write_next(IFILE *);
static void put_unit_unam(IFILE *, Symbol);
static void putdcl(IFILE *ofile, Declaredmap d) /*;putdcl*/
{
Fordeclared fd;
char *id;
Symbol sym;
int i, n = 0;
typedef struct {
char *iden;
short sym_seq;
short sym_unit;
short visible;
}f_dmap_s;
f_dmap_s ** dptrs;
f_dmap_s * filedmap;
f_dmap_s * save_filedmap;
if (d == (Declaredmap)0) {
putnum(ofile, "putdcl-is-map-defined", 0);
return;
}
putnum(ofile, "putdcl-is-map-defined", 1); /* to indicate map defined */
n = 0; /* count number of entries where defined */
FORDECLARED(id, sym, d, fd);
n += 1;
ENDFORDECLARED(fd);
putnum(ofile, "putdcl-number-defined", n);
if (n == 0) return;
save_filedmap = filedmap = (f_dmap_s *)
ecalloct((unsigned)n, sizeof(f_dmap_s), "put-dcl-save-filedmap");
dptrs =
(f_dmap_s **) emalloct(sizeof(f_dmap_s *) * (unsigned)n, "put-dcl-dptrs");
n = 0;
FORDECLARED(id, sym, d, fd);
n++; /* number of entries seen so far */
filedmap->iden = id;
if (sym == (Symbol) 0)
filedmap->sym_seq = filedmap->sym_unit = 0;
else {
filedmap->sym_seq = S_SEQ(sym);
filedmap->sym_unit = S_UNIT(sym);
}
filedmap->visible = IS_VISIBLE(fd);
/* now, insert pointer to new record such that ids are sorted
* this is necessary (for debugging only!) to ensure entries appear
* in the same order each time the declared map is written
*/
i = n-1;
while ( i > 0 && strcmp(filedmap->iden, dptrs[i-1]->iden) < 0) {
dptrs[i] = dptrs[i-1];
i--;
}
dptrs[i] = filedmap;
filedmap++;
ENDFORDECLARED(fd);
/* now, write to file */
for (i = 0; i < n; i++ ) {
putstr(ofile, "str", dptrs[i]->iden);
putnum(ofile, "seq", dptrs[i]->sym_seq);
putnum(ofile, "unt", dptrs[i]->sym_unit);
putnum(ofile, "vis", dptrs[i]->visible);
}
efreet((char *)save_filedmap, "putdcl-save-filedmap");
efreet((char *) dptrs, "putdcl-dptrs");
}
static void putlitmap(IFILE *ofile, Symbol sym) /*;putlitmap*/
{
/* called for na_enum to output literal map.
* The literal map is a tuple, entries consisting of string followed
* by integer.
*/
Tuple tup;
int i, n;
tup = (Tuple) OVERLOADS(sym);
n = tup_size(tup);
putnum(ofile, "litmap-n", n);
for (i = 1; i <= n; i += 2) {
putstr(ofile, "litmap-str", tup[i]);
putnum(ofile, "litmap-value", (int) tup[i+1]);
}
}
static void putnod(IFILE *ofile, char *desc, Node node) /*;putnod*/
{
/* Write information for the node to a file (ofile)
* Since all the nodes in the tree all have the same N_UNIT value,
* the node can be written to the file in a more compact format.
* The N_UNIT of the node itself and of its children (N_AST1...) need not
* be written out only their N_SEQ filed needs to be written out. There
* is one complication of this scheme. OPT_NODE which is (seq=1,unit=0) will
* conflict with (seq=1,unit=X) of current unit. Therefore, in this case a
* sequence # of -1 will signify OPT_NODE.
*/
Tuple tup;
Fortup ft1;
int has_n_list = 0;
int nk;
Node nod;
short fnum[24];
int fnums = 0;
Symbol sym;
#ifdef DEBUG
if (trapns>0 && N_SEQ(node) == trapns && N_UNIT(node) == trapnu)trapn(node);
#endif
/* copy standard info */
nk = N_KIND(node);
fnum[fnums++] = nk;
fnum[fnums++] = N_SEQ(node);
if (N_LIST_DEFINED(nk)) {
tup = N_LIST(node);
if (tup == (Tuple)0)
has_n_list = 0;
else
has_n_list = 1 + tup_size(tup);
fnum[fnums++] = has_n_list;
}
/* ast fields */
/* See comment above for description of compact format.*/
if (N_AST1_DEFINED(nk)) {
nod = N_AST1(node);
fnum[fnums++] = (N_UNIT(nod) != 0) ? N_SEQ(nod) : -1;
}
if (N_AST2_DEFINED(nk)) {
nod = N_AST2(node);
fnum[fnums++] = (N_UNIT(nod) != 0) ? N_SEQ(nod) : -1;
}
if (N_AST3_DEFINED(nk)) {
nod = N_AST3(node);
fnum[fnums++] = (N_UNIT(nod) != 0) ? N_SEQ(nod) : -1;
}
if (N_AST4_DEFINED(nk)) {
nod = N_AST4(node);
fnum[fnums++] = (N_UNIT(nod) != 0) ? N_SEQ(nod) : -1;
}
/*fnum[fnums++] = N_SIDE(node);*/
/* N_UNQ only if defined */
if (N_UNQ_DEFINED(nk)) {
sym = N_UNQ(node);
fnum[fnums++] = (sym != (Symbol)0) ? S_SEQ(sym) : 0;
fnum[fnums++] = (sym != (Symbol)0) ? S_UNIT(sym) : 0;
}
if (N_TYPE_DEFINED(nk)) {
sym = N_TYPE(node);
fnum[fnums++] = (sym != (Symbol)0) ? S_SEQ(sym) : 0;
fnum[fnums++] = (sym != (Symbol)0) ? S_UNIT(sym) : 0;
}
/* write fnums followed by fnum info as array */
putnum(ofile, desc, fnums);
/*fwrite((char *) &fnums, sizeof(short), 1, ofile->fh_file);*/
fwrite((char *) fnum, sizeof(short), fnums, ofile->fh_file);
/* write out n_list if needed */
if (has_n_list>1) {
tup = N_LIST(node);
FORTUP(nod = (Node), tup, ft1);
putnodref(ofile, "n-list-nodref", nod);
ENDFORTUP(ft1);
}
if (N_VAL_DEFINED(nk)) {
putnval(ofile, node);
}
}
static void putnodref(IFILE *ofile, char *desc, Node node) /*;putnodref*/
{
/* OPT_NODE is node in unit 0 with sequence 1, and needs
* no special handling here
*/
if (node == (Node)0) {
putpos(ofile, "nref-seq", 0);
putunt(ofile, "nref-unt", 0);
}
else {
putpos(ofile, "nref-seq", N_SEQ(node));
putunt(ofile, "nref-unt", N_UNIT(node));
}
}
static void putint(IFILE *ofile, char *desc, int n) /*;putint*/
{
/* write int to output file */
int s = n;
fwrite((char *) &s, sizeof(int), 1, ofile->fh_file);
}
static void putlong(IFILE *ofile, char *desc, long n) /*;putlong*/
{
/* write long to output file */
long s = n;
fwrite((char *) &s, sizeof(long), 1, ofile->fh_file);
}
static void putmisc(IFILE *ofile, Symbol sym) /*;putmisc*/
{
/* write out MISC information if present
* MISC is integer except for package, in which case it is a triple.
* The first two components are integers, the last is a tuple of
* symbols
*/
int nat, i, n;
char *m;
Tuple tup;
nat = NATURE(sym);
m = MISC(sym);
if ((nat == na_package || nat == na_package_spec )&& m != (char *)0) {
tup = (Tuple) m;
putnum(ofile, "misc-package-1", (int)tup[1]);
putnum(ofile, "misc-package-2", (int)tup[2]);
tup = (Tuple) tup[3];
n = tup_size(tup);
putnum(ofile, "misc-package-tupsize", n);
for (i = 1; i <= n; i++)
putsymref(ofile, "misc-package-symref", (Symbol) tup[i]);
}
else if ((nat == na_procedure || nat == na_function) && m != (char *)0) {
/* misc is tuple. first entry is string, second is symbol */
tup = (Tuple) m;
putnum(ofile, "misc-number", (int) tup[1]);
putsymref(ofile, "misc-symref", (Symbol) tup[2]);
}
else {
putnum(ofile, "misc", (int)m);
}
}
static void putrepr(IFILE *ofile, Symbol sym) /*;putrepr*/
{
/* write out representation